Study 1
study_1_data <- read_csv(here("data/study-1_tidy_data.csv")) %>%
mutate(
relationship = factor(
relationship,
levels = c("No info", "Symmetric", "Asymmetric")
),
next_interaction = factor(
next_interaction,
levels = c("Reciprocity", "Precedent", "None")
)
)
## Rows: 3186 Columns: 6
## ── Column specification ──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): subject_id, story, relationship, next_interaction
## dbl (2): likert_rating, normalized_likert_rating
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
study_1_summary <- study_1_data %>%
group_by(relationship, next_interaction) %>%
tidyboot_mean(likert_rating, na.rm = T)
## Warning: There was 1 warning in `dplyr::mutate()`.
## ℹ In argument: `strap = purrr::map(strap, dplyr::as_data_frame)`.
## Caused by warning:
## ! `as_data_frame()` was deprecated in tibble 2.0.0.
## ℹ Please use `as_tibble()` (with slightly different semantics) to convert to a tibble, or `as.data.frame()` to convert to a data frame.
## ℹ The deprecated feature was likely used in the purrr package.
## Please report the issue at <https://github.com/tidyverse/purrr/issues>.
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
study_1_summary_scenario <- study_1_data %>%
group_by(relationship, next_interaction, story) %>%
tidyboot_mean(likert_rating, na.rm = T)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
ggplot(
study_1_data,
aes(x = relationship, y = likert_rating, fill = next_interaction)
) +
geom_violin(
bw = 0.43,
position = position_dodge(width = 0.7),
alpha = 0.8
) +
geom_pointrange(
data = study_1_summary,
aes(
x = relationship,
y = empirical_stat,
ymin = ci_lower,
ymax = ci_upper
),
size = 0.3,
linewidth = 1,
position = position_dodge(width = 0.7)
) +
scale_fill_manual(values = action_colors) +
scale_color_manual(values = action_colors) +
scale_y_continuous(breaks = c(1, 2, 3, 4, 5, 6, 7)) +
labs(
title = "Study 1: Equal vs. hierarchical",
x = "Relationship",
y = "How likely?",
fill = "Next interaction"
) +
theme(legend.position = "bottom")
## Warning: Removed 7 rows containing non-finite outside the scale range
## (`stat_ydensity()`).
ggsave(here("figures/study-1_main.pdf"))
## Saving 6 x 3.5 in image
## Warning: Removed 7 rows containing non-finite outside the scale range
## (`stat_ydensity()`).
ggplot(
study_1_data,
aes(x = relationship, y = likert_rating, fill = next_interaction)
) +
geom_violin(
bw = 0.43,
position = position_dodge(width = 0.7),
alpha = 0.8
) +
geom_pointrange(
data = study_1_summary_scenario,
aes(
x = relationship,
y = empirical_stat,
ymin = ci_lower,
ymax = ci_upper
),
size = 0.3,
linewidth = 1,
position = position_dodge(width = 0.7)
) +
scale_fill_manual(values = action_colors) +
scale_color_manual(values = action_colors) +
scale_y_continuous(breaks = c(1, 2, 3, 4, 5, 6, 7)) +
labs(
title = "Study 1: Equal vs. hierarchical",
x = "Relationship",
y = "How likely?",
fill = "Next interaction"
) +
theme(legend.position = "bottom") +
facet_wrap(~story, nrow = 6)
## Warning: Removed 7 rows containing non-finite outside the scale range
## (`stat_ydensity()`).
# ggsave(here("figures/study-1_scenarios.pdf"))
Study 2
study_2_data <- read_csv(here("data/study-2_tidy_data.csv")) %>%
mutate(
relationship = factor(
relationship,
levels = c("Equal", "Lower", "Higher")
),
next_interaction = factor(
next_interaction,
levels = c("Reciprocity", "Precedent", "None")
)
)
## Rows: 3186 Columns: 16
## ── Column specification ──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): subject_id, story, relationship, next_interaction
## dbl (12): likert_rating, normalized_likert_rating, n_benefit, n_effort, diff...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
study_2_summary <- study_2_data %>%
group_by(relationship, next_interaction) %>%
tidyboot_mean(likert_rating, na.rm = T)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
study_2_summary_scenario <- study_2_data %>%
group_by(relationship, next_interaction, story) %>%
tidyboot_mean(likert_rating, na.rm = T)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
ggplot(
study_2_data,
aes(x = relationship, y = likert_rating, fill = next_interaction)
) +
geom_violin(
bw = 0.43,
position = position_dodge(width = 0.7),
alpha = 0.8
) +
geom_pointrange(
data = study_2_summary,
aes(
x = relationship,
y = empirical_stat,
ymin = ci_lower,
ymax = ci_upper
),
size = 0.3,
linewidth = 1,
position = position_dodge(width = 0.7)
) +
scale_fill_manual(values = action_colors) +
scale_color_manual(values = action_colors) +
scale_y_continuous(breaks = c(1, 2, 3, 4, 5, 6, 7)) +
labs(
title = "Study 2: Relative rank",
x = "Rank of generous character",
y = "How likely?",
fill = "Next interaction"
) +
theme(legend.position = "bottom")
## Warning: Removed 12 rows containing non-finite outside the scale range
## (`stat_ydensity()`).
# ggsave(here("figures/study-2_main.pdf"))
ggplot(
study_2_data,
aes(x = relationship, y = likert_rating, fill = next_interaction)
) +
geom_violin(
bw = 0.43,
position = position_dodge(width = 0.7),
alpha = 0.8
) +
geom_pointrange(
data = study_2_summary_scenario,
aes(
x = relationship,
y = empirical_stat,
ymin = ci_lower,
ymax = ci_upper
),
size = 0.3,
linewidth = 1,
position = position_dodge(width = 0.7)
) +
scale_fill_manual(values = action_colors) +
scale_color_manual(values = action_colors) +
scale_y_continuous(breaks = c(1, 2, 3, 4, 5, 6, 7)) +
labs(
title = "Study 2: Relative rank",
x = "Rank of generous character",
y = "How likely?",
fill = "Next interaction"
) +
theme(legend.position = "bottom") +
facet_wrap(~story, nrow = 6)
## Warning: Removed 12 rows containing non-finite outside the scale range
## (`stat_ydensity()`).
# ggsave(here("figures/study-2_scenarios.pdf"))
Validation study
TODO: Move from other R script
Effect size benefit over effort
study_2_benefit_effort <- read.csv(here("data/study-2_benefit_effort.csv")) %>%
rename(
diff_x = diff,
ci_lower_x = ci_lower,
ci_upper_x = ci_upper
) %>%
mutate(relationship = factor(relationship, levels = c("Lower", "Higher")))
study_2_benefit_effort_summary <- study_2_benefit_effort %>%
group_by(story, relationship, type, diff_x, ci_lower_x, ci_upper_x) %>%
tidyboot_mean(p_prec, na.rm = TRUE) %>%
rename(p_prec = empirical_stat)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
appender <- function(string, suffix = "-rank generous") paste0(string, suffix)
ggplot(study_2_benefit_effort_summary %>% filter(type == "benefit"), aes(x = diff_x, y = p_prec, color = relationship)) +
geom_point(size = 3, alpha = 0.3) +
geom_smooth(method = "lm", fill = "lightgray") +
geom_errorbar(mapping = aes(x = diff_x, ymin = ci_lower, ymax = ci_upper), size = 1.5, width = 0.13, alpha = 0.3) +
geom_errorbarh(mapping = aes(y = p_prec, xmin = ci_lower_x, xmax = ci_upper_x), size = 1.5, height = 0.015, alpha = 0.3) +
geom_hline(yintercept = 0.5, linetype = "dashed", color = "gray") +
scale_color_manual(values = c("Higher" = "#DC267F", "Lower" = "#785EF0")) +
labs(
x = "Differential benefit",
y = "P(Precedent)",
title = "Study 2: Differential benefit vs. likelihood of a precedent"
) +
theme(legend.position = "none") +
facet_grid(~relationship, labeller = as_labeller(appender))
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was generated.
## `geom_smooth()` using formula = 'y ~ x'
ggsave(here("figures/study-2_benefit.pdf"))
## Saving 7 x 4 in image
## `geom_smooth()` using formula = 'y ~ x'
ggplot(study_2_benefit_effort_summary %>% filter(type == "effort"), aes(x = diff_x, y = p_prec, color = relationship)) +
geom_point(size = 3, alpha = 0.3) +
geom_smooth(method = "lm", fill = "lightgray") +
geom_errorbar(mapping = aes(x = diff_x, ymin = ci_lower, ymax = ci_upper), size = 1.5, width = 0.13, alpha = 0.3) +
geom_errorbarh(mapping = aes(y = p_prec, xmin = ci_lower_x, xmax = ci_upper_x), size = 1.5, height = 0.015, alpha = 0.3) +
geom_hline(yintercept = 0.5, linetype = "dashed", color = "gray") +
scale_color_manual(values = c("Higher" = "#DC267F", "Lower" = "#785EF0")) +
labs(
x = "Differential effort",
y = "P(Precedent)",
title = "Study 2: Differential effort vs. likelihood of a precedent"
) +
theme(legend.position = "none") +
facet_grid(~relationship, labeller = as_labeller(appender))
## `geom_smooth()` using formula = 'y ~ x'
ggsave(here("figures/study-2_effort.pdf"))
## Saving 7 x 4 in image
## `geom_smooth()` using formula = 'y ~ x'
Study 3
study_3_data <- read_csv(here("data/study-3_tidy_data.csv")) %>%
mutate(
relationship = factor(
relationship,
levels = c("Equal", "Lower", "Higher")
),
next_interaction = factor(
next_interaction,
levels = c("Reciprocity", "Precedent", "None")
)
)
## Rows: 3078 Columns: 24
## ── Column specification ──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────
## Delimiter: ","
## chr (5): subject_id, story, relationship, next_interaction, concrete_relati...
## dbl (19): likert_rating, normalized_likert_rating, conflict, coercion, impor...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
study_3_summary <- study_3_data %>%
group_by(relationship, next_interaction) %>%
tidyboot_mean(likert_rating, na.rm = T)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
study_3_summary_scenario <- study_3_data %>%
group_by(relationship, next_interaction, story) %>%
tidyboot_mean(likert_rating, na.rm = T)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
ggplot(
study_3_data,
aes(x = relationship, y = likert_rating, fill = next_interaction)
) +
geom_violin(
bw = 0.43,
position = position_dodge(width = 0.7),
alpha = 0.8
) +
geom_pointrange(
data = study_3_summary,
aes(
x = relationship,
y = empirical_stat,
ymin = ci_lower,
ymax = ci_upper
),
size = 0.3,
linewidth = 1,
position = position_dodge(width = 0.7)
) +
scale_fill_manual(values = action_colors) +
scale_color_manual(values = action_colors) +
scale_y_continuous(breaks = c(1, 2, 3, 4, 5, 6, 7)) +
labs(
title = "Study 3: Concrete relationships",
x = "Rank of generous character",
y = "How likely?",
fill = "Next interaction"
) +
theme(legend.position = "bottom")
## Warning: Removed 14 rows containing non-finite outside the scale range
## (`stat_ydensity()`).
# ggsave(here("figures/study-4_main.pdf"))
ggplot(
study_3_data,
aes(x = relationship, y = likert_rating, fill = next_interaction)
) +
geom_violin(
bw = 0.43,
position = position_dodge(width = 0.7),
alpha = 0.8
) +
geom_pointrange(
data = study_3_summary_scenario,
aes(
x = relationship,
y = empirical_stat,
ymin = ci_lower,
ymax = ci_upper
),
size = 0.3,
linewidth = 1,
position = position_dodge(width = 0.7)
) +
scale_fill_manual(values = action_colors) +
scale_color_manual(values = action_colors) +
scale_y_continuous(breaks = c(1, 2, 3, 4, 5, 6, 7)) +
labs(
title = "Study 3: Concrete relationships",
x = "Rank of generous character",
y = "How likely?",
fill = "Next interaction"
) +
theme(legend.position = "bottom") +
facet_wrap(~story, nrow = 6)
## Warning: Removed 14 rows containing non-finite outside the scale range
## (`stat_ydensity()`).
ggsave(here("figures/study-3_scenarios.pdf"))
## Saving 10 x 10.5 in image
## Warning: Removed 14 rows containing non-finite outside the scale range
## (`stat_ydensity()`).
Effect size benefit over effort
study_3_benefit_effort <- read.csv(here("data/study-3_benefit_effort.csv")) %>%
rename(
diff_x = diff,
ci_lower_x = ci_lower,
ci_upper_x = ci_upper
) %>%
mutate(relationship = factor(relationship, levels = c("Lower", "Higher")))
study_3_benefit_effort_summary <- study_3_benefit_effort %>%
group_by(story, relationship, type, diff_x, ci_lower_x, ci_upper_x) %>%
tidyboot_mean(p_prec, na.rm = TRUE) %>%
rename(p_prec = empirical_stat)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
appender <- function(string, suffix = "-rank generous") paste0(string, suffix)
ggplot(study_3_benefit_effort_summary %>% filter(type == "benefit"), aes(x = diff_x, y = p_prec, color = relationship)) +
geom_point(size = 3, alpha = 0.3) +
geom_smooth(method = "lm", fill = "lightgray") +
geom_errorbar(mapping = aes(x = diff_x, ymin = ci_lower, ymax = ci_upper), size = 1.5, width = 0.13, alpha = 0.3) +
geom_errorbarh(mapping = aes(y = p_prec, xmin = ci_lower_x, xmax = ci_upper_x), size = 1.5, height = 0.015, alpha = 0.3) +
geom_hline(yintercept = 0.5, linetype = "dashed", color = "gray") +
scale_color_manual(values = c("Higher" = "#DC267F", "Lower" = "#785EF0")) +
labs(
x = "Differential benefit",
y = "P(Precedent)",
title = "Study 3: Differential benefit vs. likelihood of a precedent"
) +
theme(legend.position = "none") +
facet_grid(~relationship, labeller = as_labeller(appender))
## `geom_smooth()` using formula = 'y ~ x'
ggsave(here("figures/study-3_benefit.pdf"))
## Saving 7 x 4 in image
## `geom_smooth()` using formula = 'y ~ x'
ggplot(study_3_benefit_effort_summary %>% filter(type == "effort"), aes(x = diff_x, y = p_prec, color = relationship)) +
geom_point(size = 3, alpha = 0.3) +
geom_smooth(method = "lm", fill = "lightgray") +
geom_errorbar(mapping = aes(x = diff_x, ymin = ci_lower, ymax = ci_upper), size = 1.5, width = 0.13, alpha = 0.3) +
geom_errorbarh(mapping = aes(y = p_prec, xmin = ci_lower_x, xmax = ci_upper_x), size = 1.5, height = 0.015, alpha = 0.3) +
geom_hline(yintercept = 0.5, linetype = "dashed", color = "gray") +
scale_color_manual(values = c("Higher" = "#DC267F", "Lower" = "#785EF0")) +
labs(
x = "Differential effort",
y = "P(Precedent)",
title = "Study 3: Differential effort vs. likelihood of a precedent"
) +
theme(legend.position = "none") +
facet_grid(~relationship, labeller = as_labeller(appender))
## `geom_smooth()` using formula = 'y ~ x'
ggsave(here("figures/study-3_effort.pdf"))
## Saving 7 x 4 in image
## `geom_smooth()` using formula = 'y ~ x'
Study 4
study_4_data <- read_csv(here("data/study-4_tidy_data.csv")) %>%
mutate(
first_actual = factor(
first_actual,
levels = c("Equal", "Lower", "Higher")
),
first_response = factor(
first_response,
levels = c("Equal", "Lower", "Higher")
)
) %>% mutate(
Expectations = factor(Expectations, levels = c("Consistent", "Inconsistent"))
)
## Rows: 2034 Columns: 18
## ── Column specification ──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────
## Delimiter: ","
## chr (8): subject_id, story, first_actual, strategy, first_response, second_...
## dbl (10): n_benefit, n_effort, diff_benefit, diff_effort, ci_lower_benefit, ...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
# Implicit coordination
study_4_first_time_summary <-
study_4_data %>%
mutate(first_response = recode(first_response, "Higher" = 0, "Lower" = 1)) %>%
group_by(story, diff_effort, ci_lower_effort, ci_upper_effort, diff_benefit, ci_lower_benefit, ci_upper_benefit) %>%
tidyboot_mean(first_response, na.rm = TRUE)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
d.temp <- study_4_first_time_summary %>%
arrange(desc(mean))
levs <- unique(d.temp$story)
study_4_first_time_summary$story <-
factor(study_4_first_time_summary$story, levels = levs)
# First vs. second time
study_4_second_summary <-
study_4_data %>%
filter(symmetric == "Asymmetric") %>%
mutate(second_response = recode(second_response, "Higher" = 0, "Lower" = 1)) %>%
group_by(story, first_actual) %>%
tidyboot_mean(second_response, na.rm = TRUE)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
study_4_first_second_summary <-
left_join(
study_4_first_time_summary,
study_4_second_summary,
suffix = c("_first", "_second"),
by = (c("story"))
)
Do we replicate the previous results?
study_4_summary <- study_4_data %>%
mutate(strategy = recode(
strategy,
"Precedent" = 1,
"Reciprocity" = 0
)) %>%
group_by(first_response, first_actual, Expectations) %>%
tidyboot_mean(strategy, na.rm = TRUE)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
ggplot(study_4_summary, aes(x = first_actual, y = empirical_stat, color = first_actual, shape = Expectations)) +
geom_pointrange(
aes(ymin = ci_lower, ymax = ci_upper),
size = 1.0,
linewidth = 1.8,
position = position_dodge(width = 0.2),
) +
geom_hline(yintercept = 0.5, linetype = "dashed", color = "gray") +
scale_color_manual(values = relationship_colors, guide = "none") +
scale_shape_discrete(name = "First time prediction") +
scale_y_continuous(limits = c(0, 1)) +
labs(
x = "Rank of generous actor",
y = "P(Precedent)"
) +
theme(legend.position = "right")
ggsave(here("figures/study-4_main.pdf"))
## Saving 6 x 3.2 in image
Implicit cooordination
First time plots
ggplot(study_4_first_time_summary, aes(x = story, y = empirical_stat)) +
geom_pointrange(
data = study_4_first_time_summary,
aes(
x = story,
y = empirical_stat,
ymin = ci_lower,
ymax = ci_upper
),
size = 0.7,
linewidth = 1.5
) +
geom_hline(
yintercept = 0.5,
linetype = "dashed",
color = "gray",
alpha = 0.5
) +
scale_y_continuous(limits = c(0, 1)) +
labs(x = "Scenario", y = "P(lower-rank generous)", title = "Study 3: Implicit coordination") +
theme(axis.text.x = element_text(angle = 30, hjust = 1))
ggsave(here("figures/study-4_implicit.pdf"))
## Saving 8 x 3.5 in image
Correlate benefit and effort with implicit coordination expectations
ggplot(study_4_first_second_summary, aes(x = diff_effort, y = empirical_stat_first)) +
geom_point(size = 3, alpha = 0.3) +
geom_smooth(method = "lm", fill = "lightgray") +
geom_errorbar(mapping = aes(x = diff_effort, ymin = ci_lower_first, ymax = ci_upper_first), size = 1.5, width = 0.11, alpha = 0.3) +
geom_errorbarh(mapping = aes(y = empirical_stat_first, xmin = ci_lower_effort, xmax = ci_upper_effort), size = 1.5, height = 0.03, alpha = 0.3) +
geom_hline(yintercept = 0.5, linetype = "dashed", color = "gray") +
lims(y = c(0, 1)) +
labs(
x = "Differential effort",
y = "P(Lower-ranked generous)"
) +
theme(legend.position = "none")
## `geom_smooth()` using formula = 'y ~ x'
ggsave(here("figures/study-4_effort-first-time.pdf"))
## Saving 4.5 x 4 in image
## `geom_smooth()` using formula = 'y ~ x'
ggplot(study_4_first_second_summary, aes(x = diff_benefit, y = empirical_stat_first)) +
geom_point(size = 3, alpha = 0.3) +
geom_smooth(method = "lm", fill = "lightgray") +
geom_errorbar(mapping = aes(x = diff_benefit, ymin = ci_lower_first, ymax = ci_upper_first), size = 1.5, width = 0.11, alpha = 0.3) +
geom_errorbarh(mapping = aes(y = empirical_stat_first, xmin = ci_lower_benefit, xmax = ci_upper_benefit), size = 1.5, height = 0.03, alpha = 0.3) +
geom_hline(yintercept = 0.5, linetype = "dashed", color = "gray") +
lims(y = c(0, 1)) +
labs(
x = "Differential benefit",
y = "P(Lower-ranked generous)"
) +
theme(legend.position = "none")
## `geom_smooth()` using formula = 'y ~ x'
ggsave(here("figures/study-4_benefit-first-time.pdf"))
## Saving 4.5 x 4 in image
## `geom_smooth()` using formula = 'y ~ x'
Main plot: First time vs. second time
ggplot(
study_4_first_second_summary,
aes(x = empirical_stat_first, y = empirical_stat_second, color = first_actual)
) +
geom_smooth(
method = "lm",
fill = "lightgray",
linewidth = 1.3
) +
geom_point(
size = 3.6,
alpha = 0.3,
stroke = 0
) +
geom_errorbar(
mapping = aes(x = empirical_stat_first, ymin = ci_lower_second, ymax = ci_upper_second),
size = 1.5,
width = 0.03,
alpha = 0.3
) +
geom_errorbarh(
mapping = aes(y = empirical_stat_second, xmin = ci_lower_first, xmax = ci_upper_first),
size = 1.5,
height = 0.03,
alpha = 0.3
) +
geom_hline(
yintercept = 0.5,
linetype = "dashed",
color = "gray"
) +
geom_vline(
xintercept = 0.5,
linetype = "dashed",
color = "gray"
) +
scale_y_continuous(limits = c(0, 1)) +
scale_x_continuous(limits = c(0, 1)) +
scale_color_manual(values = c("Higher" = "#DC267F", "Lower" = "#785EF0")) +
labs(x = "Expected first time (Study 4)", y = "Predicted next time (Study 4)", color = "Observed rank of generous actor") +
theme(legend.position = "bottom")
## `geom_smooth()` using formula = 'y ~ x'
ggsave(here("figures/study-4_first_second.pdf"))
## Saving 4.5 x 4.5 in image
## `geom_smooth()` using formula = 'y ~ x'
Study 4 vs. Study 2
study_2_first_second <- study_2_data %>%
filter(relationship != "Equal", next_interaction != "None") %>%
group_by(subject_id, story, relationship) %>%
mutate(
total_rating = sum(likert_rating),
normalized_likert_rating = likert_rating / total_rating
) %>%
select(-total_rating) %>%
ungroup() %>%
rename(first_actual = relationship) %>%
mutate(
second_response = case_when(
next_interaction == "Precedent" ~ first_actual,
next_interaction == "Reciprocity" ~ ifelse(first_actual == "Higher", "Lower", "Higher"),
next_interaction == "None" ~ "None"
)
)
study_2_first_second_summary <- study_2_first_second %>%
filter(second_response == "Lower") %>%
group_by(story, first_actual) %>%
tidyboot_mean(normalized_likert_rating, na.rm = T)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
studies_2_4_summary <-
left_join(
study_2_first_second_summary,
study_4_first_time_summary,
suffix = c("_2", "_4"),
by = (c("story"))
)
ggplot(
studies_2_4_summary,
aes(x = empirical_stat_4, y = empirical_stat_2, color = first_actual)
) +
geom_point(
size = 3.3,
alpha = 0.3,
stroke = 0
) +
geom_smooth(
method = "lm",
fill = "lightgray",
linewidth = 1.3
) +
geom_errorbar(
mapping = aes(x = empirical_stat_4, ymin = ci_lower_2, ymax = ci_upper_2),
size = 1.5,
width = 0.03,
alpha = 0.3
) +
geom_errorbarh(
mapping = aes(y = empirical_stat_2, xmin = ci_lower_4, xmax = ci_upper_4),
size = 1.5,
height = 0.03,
alpha = 0.3
) +
geom_hline(
yintercept = 0.5,
linetype = "dashed",
color = "gray"
) +
geom_vline(
xintercept = 0.5,
linetype = "dashed",
color = "gray"
) +
scale_y_continuous(limits = c(0.2, 0.8)) +
scale_x_continuous(limits = c(0, 1)) +
scale_color_manual(values = c("Higher" = "#DC267F", "Lower" = "#785EF0")) +
labs(x = "Expected first time (Study 4)", y = "Predicted next time (Study 2)", color = "Observed rank of generous actor") +
theme(legend.position = "bottom")
## `geom_smooth()` using formula = 'y ~ x'
ggsave(here("figures/study-2-4_first_second.pdf"))
## Saving 4.5 x 4.5 in image
## `geom_smooth()` using formula = 'y ~ x'
Study 4 vs. Study 3 (concrete relationships)
study_3_first_second <- study_3_data %>%
filter(relationship != "Equal", next_interaction != "None") %>%
group_by(subject_id, story, relationship) %>%
mutate(
total_rating = sum(likert_rating),
normalized_likert_rating = likert_rating / total_rating
) %>%
select(-total_rating) %>%
ungroup() %>%
rename(first_actual = relationship) %>%
mutate(
second_response = case_when(
next_interaction == "Precedent" ~ first_actual,
next_interaction == "Reciprocity" ~ ifelse(first_actual == "Higher", "Lower", "Higher"),
next_interaction == "None" ~ "None"
)
)
study_3_first_second_summary <- study_3_first_second %>%
filter(second_response == "Lower") %>%
group_by(story, first_actual, prestige_score, dominance_score) %>%
tidyboot_mean(normalized_likert_rating, na.rm = T)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
studies_3_4_summary <-
left_join(
study_3_first_second_summary,
study_4_first_time_summary,
suffix = c("_3", "_4"),
by = (c("story"))
)
studies_3_4_all <-
left_join(
study_3_first_second,
study_4_first_time_summary,
suffix = c("_3", "_4"),
by = (c("story", "diff_benefit", "ci_lower_benefit", "ci_upper_benefit", "diff_effort", "ci_lower_effort", "ci_upper_effort"))
) %>%
rename(expected.first.3 = empirical_stat, expected.next.4 = normalized_likert_rating) %>%
filter(second_response == "Lower")
ggplot(
studies_3_4_summary,
aes(x = empirical_stat_4, y = empirical_stat_3, color = first_actual)
) +
geom_point(
size = 3.3,
alpha = 0.3,
stroke = 0
) +
geom_smooth(
method = "lm",
fill = "lightgray",
linewidth = 1.3
) +
geom_errorbar(
mapping = aes(x = empirical_stat_4, ymin = ci_lower_3, ymax = ci_upper_3),
size = 1.5,
width = 0.03,
alpha = 0.3
) +
geom_errorbarh(
mapping = aes(y = empirical_stat_3, xmin = ci_lower_4, xmax = ci_upper_4),
size = 1.5,
height = 0.03,
alpha = 0.3
) +
geom_hline(
yintercept = 0.5,
linetype = "dashed",
color = "gray"
) +
geom_vline(
xintercept = 0.5,
linetype = "dashed",
color = "gray"
) +
scale_y_continuous(limits = c(0.2, 0.8)) +
scale_x_continuous(limits = c(0, 1)) +
scale_color_manual(values = c("Higher" = "#DC267F", "Lower" = "#785EF0")) +
labs(x = "Expected first time (Study 4)", y = "Predicted next time (Study 3)", color = "Observed rank of generous actor") +
theme(legend.position = "bottom")
## `geom_smooth()` using formula = 'y ~ x'
ggsave(here("figures/study-3-4_first_second.pdf"))
## Saving 4.5 x 4.5 in image
## `geom_smooth()` using formula = 'y ~ x'
ggplot(
studies_3_4_summary,
aes(x = prestige_score, y = empirical_stat_3, color = first_actual)
) +
geom_point(
size = 3.3,
alpha = 0.3,
stroke = 0
) +
geom_smooth(
method = "lm",
fill = "lightgray",
linewidth = 1.3
) +
geom_errorbar(
mapping = aes(x = prestige_score, ymin = ci_lower_3, ymax = ci_upper_3),
size = 1.5,
width = 0.03,
alpha = 0.3
) +
geom_hline(
yintercept = 0.5,
linetype = "dashed",
color = "gray"
) +
scale_y_continuous(limits = c(0.2, 0.8)) +
scale_color_manual(values = c("Higher" = "#DC267F", "Lower" = "#785EF0")) +
labs(x = "Prestige score", y = "Study 3 P(lower-rank generous)", color = "Observed rank of generous actor") +
theme(legend.position = "none")
## `geom_smooth()` using formula = 'y ~ x'
ggsave(here("figures/study-3_prestige.pdf"))
## Saving 4 x 4 in image
## `geom_smooth()` using formula = 'y ~ x'
ggplot(
studies_3_4_summary,
aes(x = dominance_score, y = empirical_stat_3, color = first_actual)
) +
geom_point(
size = 3.3,
alpha = 0.3,
stroke = 0
) +
geom_smooth(
method = "lm",
fill = "lightgray",
linewidth = 1.3
) +
geom_errorbar(
mapping = aes(x = dominance_score, ymin = ci_lower_3, ymax = ci_upper_3),
size = 1.5,
width = 0.03,
alpha = 0.3
) +
geom_hline(
yintercept = 0.5,
linetype = "dashed",
color = "gray"
) +
scale_y_continuous(limits = c(0.2, 0.8)) +
scale_color_manual(values = c("Higher" = "#DC267F", "Lower" = "#785EF0")) +
labs(x = "Dominance score", y = "Study 3 P(lower-rank generous)", color = "Observed rank of generous actor") +
theme(legend.position = "none")
## `geom_smooth()` using formula = 'y ~ x'
ggsave(here("figures/study-3_dominance.pdf"))
## Saving 4 x 4 in image
## `geom_smooth()` using formula = 'y ~ x'
plot correlation of dominance score vs. prestige score
ggplot(studies_3_4_summary, aes(x = dominance_score, y = prestige_score)) +
geom_point(size = 2.5) +
geom_smooth(method = "lm", fill = "lightgray", linewidth = 1.3) +
labs(x = "Dominance score", y = "Prestige score")
## `geom_smooth()` using formula = 'y ~ x'
ggsave(here("figures/dominance_vs_prestige.pdf"))
## Saving 4 x 4 in image
## `geom_smooth()` using formula = 'y ~ x'
cor.test(studies_3_4_summary$dominance_score, studies_3_4_summary$prestige_score, method = "pearson")
##
## Pearson's product-moment correlation
##
## data: studies_3_4_summary$dominance_score and studies_3_4_summary$prestige_score
## t = 1.3814, df = 34, p-value = 0.1762
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.1060351 0.5197058
## sample estimates:
## cor
## 0.2305315
Plot ‘first time’ with dominance score, see how much they are related
studies_3_4_lower_summary <- studies_3_4_summary %>%
filter(first_actual == "Lower")
studies_3_4_higher_summary <- studies_3_4_summary %>%
filter(first_actual == "Higher")
Correlation of dominance score vs. first time P(lower-rank generous)
cor.test(studies_3_4_lower_summary$dominance_score, studies_3_4_lower_summary$empirical_stat_4, method = "pearson")
##
## Pearson's product-moment correlation
##
## data: studies_3_4_lower_summary$dominance_score and studies_3_4_lower_summary$empirical_stat_4
## t = 0.71697, df = 16, p-value = 0.4837
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.3165104 0.5943445
## sample estimates:
## cor
## 0.1764307
Correlation of prestige score vs. first time P(lower-rank generous)
cor.test(studies_3_4_higher_summary$prestige_score, studies_3_4_higher_summary$empirical_stat_4, method = "pearson")
##
## Pearson's product-moment correlation
##
## data: studies_3_4_higher_summary$prestige_score and studies_3_4_higher_summary$empirical_stat_4
## t = -0.53666, df = 16, p-value = 0.5989
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.5647821 0.3559962
## sample estimates:
## cor
## -0.1329748
ggplot(
studies_3_4_lower_summary,
aes(x = dominance_score, y = empirical_stat_4)
) +
geom_pointrange(
aes(y = empirical_stat_4, ymin = ci_lower_4, ymax = ci_upper_4),
size = 0.7,
linewidth = 1.5
) +
geom_smooth(
method = "lm",
fill = "lightgray",
linewidth = 1.3
) +
geom_hline(
yintercept = 0.5,
linetype = "dashed",
color = "gray"
) +
lims(y = c(0, 1)) +
labs(y = "Study 4 First time P(lower-rank generous)", x = "Dominance score")
## `geom_smooth()` using formula = 'y ~ x'
ggsave(here("figures/study-4_dominance-vs-first.pdf"))
## Saving 4 x 4 in image
## `geom_smooth()` using formula = 'y ~ x'
ggplot(
studies_3_4_higher_summary,
aes(x = prestige_score, y = empirical_stat_4)
) +
geom_pointrange(
aes(y = empirical_stat_4, ymin = ci_lower_4, ymax = ci_upper_4),
size = 0.7,
linewidth = 1.5
) +
geom_smooth(
method = "lm",
fill = "lightgray",
linewidth = 1.3
) +
geom_hline(
yintercept = 0.5,
linetype = "dashed",
color = "gray"
) +
lims(y = c(0, 1)) +
labs(y = "Study 4 First time P(lower-rank generous)", x = "Prestige score")
## `geom_smooth()` using formula = 'y ~ x'
ggsave(here("figures/study-4_prestige-vs-first.pdf"))
## Saving 4 x 4 in image
## `geom_smooth()` using formula = 'y ~ x'
Study 5
study_5_data <- read_csv(here("data/study-5_tidy_data.csv")) %>%
mutate(
participant_rank = case_when(
partner_status == "equal" ~ "Equal",
partner_status == "lower" ~ "Higher",
partner_status == "higher" ~ "Lower"
),
participant_rank = factor(participant_rank, levels = c("Equal", "Lower", "Higher")),
participant_first_choice = factor(
participant_first_choice,
levels = c("receive", "give"),
labels = c("Receive", "Give")
),
partner_first_choice = factor(
partner_first_choice,
levels = c("receive", "give"),
labels = c("Receive", "Give")
)
)
## Rows: 918 Columns: 15
## ── Column specification ──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────
## Delimiter: ","
## chr (9): subject_id, scenario_id, partner_status, relationship, partner_firs...
## dbl (4): participant_first_choice_generous, participant_second_choice_genero...
## lgl (2): coordination, successful_first_time
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
# Analyze first time choices by partner status
study_5_first_time_summary <- study_5_data %>%
group_by(scenario_id, participant_rank) %>%
tidyboot_mean(participant_first_choice_generous, na.rm = T)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
study_5_first_time_all <- study_5_data %>%
group_by(participant_rank) %>%
tidyboot_mean(participant_first_choice_generous, na.rm = T)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
ggplot(
study_5_first_time_summary,
aes(x = participant_rank, y = empirical_stat)
) +
geom_pointrange(
aes(y = empirical_stat, ymin = ci_lower, ymax = ci_upper),
size = 0.7,
linewidth = 1.5
) +
labs(
title = "Study 5: First time",
x = "Self rank",
y = "P(first time generous)"
) +
geom_hline(
yintercept = 0.5,
linetype = "dashed",
color = "gray"
) +
scale_y_continuous(limits = c(0, 1)) +
facet_wrap(~scenario_id) +
theme(legend.position = "none")
ggsave(here("figures/study-5_first_time_scenarios.pdf"))
## Saving 6 x 4 in image
ggplot(
study_5_first_time_all,
aes(x = participant_rank, y = empirical_stat)
) +
geom_pointrange(
aes(y = empirical_stat, ymin = ci_lower, ymax = ci_upper),
size = 0.7,
linewidth = 1.5
) +
labs(
title = "Study 5: First time",
x = "Self rank",
y = "P(Self generous first time)",
color = "Self rank"
) +
geom_hline(
yintercept = 0.5,
linetype = "dashed",
color = "gray"
) +
scale_y_continuous(limits = c(0, 1)) +
theme(legend.position = "none")
ggsave(here("figures/study-5_first_time_all.pdf"))
## Saving 2.8 x 3.2 in image
study_5_summary <- study_5_data %>%
group_by(
participant_rank,
participant_first_choice,
partner_first_choice,
successful_first_time
) %>%
tidyboot_mean(participant_second_choice_generous, na.rm = TRUE)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
Plot coordination and miscoordination separately
ggplot(study_5_summary %>% filter(successful_first_time == TRUE), aes(x = participant_rank, y = empirical_stat, color = partner_first_choice)) +
geom_pointrange(
aes(y = empirical_stat, ymin = ci_lower, ymax = ci_upper),
size = 0.7,
linewidth = 1.5,
position = position_dodge(width = 0.3)
) +
geom_hline(
yintercept = 0.5,
linetype = "dashed",
color = "gray"
) +
scale_y_continuous(limits = c(0, 1)) +
labs(
title = "Study 5: Second time (successful first time)",
x = "Self rank",
y = "P(Self generous second time)",
color = "First time generous",
shape = "First time generous"
) +
scale_color_manual(
values = c("Receive" = "#E69F00", "Give" = "#F0E442"),
labels = c("Receive" = "Self (Precedent)", "Give" = "Partner (Reciprocity)")
) +
scale_shape_manual(
values = c("Receive" = 16, "Give" = 17),
labels = c("Receive" = "Self (Precedent)", "Give" = "Partner (Reciprocity)")
)
## Warning: No shared levels found between `names(values)` of the manual scale and
## the data's shape values.
ggsave(here("figures/study-5_second_time_successful.pdf"))
## Saving 5.1 x 3.2 in image
## Warning: No shared levels found between `names(values)` of the manual scale and
## the data's shape values.
ggplot(study_5_summary %>% filter(successful_first_time == FALSE), aes(x = participant_rank, y = empirical_stat, color = partner_first_choice)) +
geom_pointrange(
aes(y = empirical_stat, ymin = ci_lower, ymax = ci_upper),
size = 0.7,
linewidth = 1.5,
position = position_dodge(width = 0.3)
) +
geom_hline(
yintercept = 0.5,
linetype = "dashed",
color = "gray"
) +
scale_y_continuous(limits = c(0, 1)) +
labs(
title = "Study 5: Second time (unsuccessful first time)",
x = "Self rank",
y = "P(Self generous second time)",
color = "First time"
) +
scale_color_grey(
start = 0.4, end = 0.7,
labels = c("Give" = "Both give", "Receive" = "Both receive")
)
ggsave(here("figures/study-5_second_time_unsuccessful.pdf"))
## Saving 4.5 x 3.2 in image
ggplot(
study_5_summary,
aes(x = partner_first_choice, y = empirical_stat, color = participant_rank)
) +
geom_pointrange(
aes(y = empirical_stat, ymin = ci_lower, ymax = ci_upper),
size = 0.7,
linewidth = 1.5,
position = position_dodge(width = 0.3)
) +
geom_hline(
yintercept = 0.5,
linetype = "dashed",
color = "gray"
) +
scale_y_continuous(limits = c(0, 1)) +
labs(
title = "Study 5: Second time choices",
x = "Observed partner first choice",
y = "P(Second time generous)",
color = "Self rank"
) +
scale_color_manual(values = relationship_colors) +
facet_wrap(~participant_first_choice,
labeller = labeller(
participant_first_choice = function(x) {
paste("First choice:", x)
}
)
) +
theme(legend.position = "bottom")
Study 6
study_6_data <- read_csv(here("data/study-6_tidy_data.csv")) %>%
mutate(
participant_rank = case_when(
partner_status == "equal" ~ "Equal",
partner_status == "lower" ~ "Higher",
partner_status == "higher" ~ "Lower"
),
participant_rank = factor(participant_rank, levels = c("Equal", "Lower", "Higher")),
participant_first_choice = factor(
participant_first_choice,
levels = c("receive", "give"),
labels = c("Receive", "Give")
),
partner_first_choice = factor(
partner_first_choice,
levels = c("receive", "give"),
labels = c("Receive", "Give")
)
)
## Rows: 948 Columns: 15
## ── Column specification ──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────
## Delimiter: ","
## chr (9): subject_id, scenario_id, partner_status, relationship, partner_firs...
## dbl (4): participant_first_choice_generous, participant_second_choice_genero...
## lgl (2): coordination, successful_first_time
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
# Analyze first time choices by partner status
study_6_first_time_summary <- study_6_data %>%
group_by(scenario_id, participant_rank) %>%
tidyboot_mean(participant_first_choice_generous, na.rm = T)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
study_6_first_time_all <- study_6_data %>%
group_by(participant_rank) %>%
tidyboot_mean(participant_first_choice_generous, na.rm = T)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
ggplot(
study_6_first_time_summary,
aes(x = participant_rank, y = empirical_stat)
) +
geom_pointrange(
aes(y = empirical_stat, ymin = ci_lower, ymax = ci_upper),
size = 0.7,
linewidth = 1.5
) +
labs(
title = "Study 6: First time",
x = "Self rank",
y = "P(First time generous)",
color = "Self rank"
) +
geom_hline(
yintercept = 0.5,
linetype = "dashed",
color = "gray"
) +
scale_y_continuous(limits = c(0, 1)) +
facet_wrap(~scenario_id) +
theme(legend.position = "none")
ggsave(here("figures/study-6_first_time_scenarios.pdf"))
## Saving 6 x 4 in image
ggplot(
study_6_first_time_all,
aes(x = participant_rank, y = empirical_stat)
) +
geom_pointrange(
aes(y = empirical_stat, ymin = ci_lower, ymax = ci_upper),
size = 0.7,
linewidth = 1.5
) +
labs(
title = "Study 6: First time",
x = "Self rank",
y = "P(Self generous first time)",
color = "Self rank"
) +
geom_hline(
yintercept = 0.5,
linetype = "dashed",
color = "gray"
) +
scale_y_continuous(limits = c(0, 1)) +
theme(legend.position = "none")
ggsave(here("figures/study-6_first_time_all.pdf"))
## Saving 2.8 x 3.2 in image
study_6_summary <- study_6_data %>%
group_by(
participant_rank,
participant_first_choice,
partner_first_choice,
successful_first_time
) %>%
tidyboot_mean(participant_second_choice_generous, na.rm = TRUE)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
Plot coordination and miscoordination separately
ggplot(study_6_summary %>% filter(successful_first_time == TRUE), aes(x = participant_rank, y = empirical_stat, color = partner_first_choice)) +
geom_pointrange(
aes(y = empirical_stat, ymin = ci_lower, ymax = ci_upper),
size = 0.7,
linewidth = 1.5,
position = position_dodge(width = 0.3)
) +
geom_hline(
yintercept = 0.5,
linetype = "dashed",
color = "gray"
) +
scale_y_continuous(limits = c(0, 1)) +
labs(
title = "Study 6: Second time (successful first time)",
x = "Self rank",
y = "P(Self generous second time)",
color = "First time generous"
) +
scale_color_manual(
values = c("Receive" = "#E69F00", "Give" = "#F0E442"),
labels = c("Receive" = "Self (Precedent)", "Give" = "Partner (Reciprocity)")
)
ggsave(here("figures/study-6_second_time_successful.pdf"))
## Saving 5.1 x 3.2 in image
ggplot(study_6_summary %>% filter(successful_first_time == FALSE), aes(x = participant_rank, y = empirical_stat, color = partner_first_choice)) +
geom_pointrange(
aes(y = empirical_stat, ymin = ci_lower, ymax = ci_upper),
size = 0.7,
linewidth = 1.5,
position = position_dodge(width = 0.3)
) +
geom_hline(
yintercept = 0.5,
linetype = "dashed",
color = "gray"
) +
scale_y_continuous(limits = c(0, 1)) +
labs(
title = "Study 6: Second time (unsuccessful first time)",
x = "Self rank",
y = "P(Self generous second time)",
color = "First time"
) +
scale_color_grey(
start = 0.4, end = 0.7,
labels = c("Give" = "Both give", "Receive" = "Both receive")
)
ggsave(here("figures/study-6_second_time_unsuccessful.pdf"))
## Saving 4.5 x 3.2 in image
ggplot(
study_6_summary,
aes(x = partner_first_choice, y = empirical_stat, color = participant_rank)
) +
geom_pointrange(
aes(y = empirical_stat, ymin = ci_lower, ymax = ci_upper),
size = 0.7,
linewidth = 1.5,
position = position_dodge(width = 0.3)
) +
geom_hline(
yintercept = 0.5,
linetype = "dashed",
color = "gray"
) +
scale_y_continuous(limits = c(0, 1)) +
labs(
title = "Study 6: Second time",
x = "Observed partner first choice",
y = "P(Second time generous)",
color = "Self rank"
) +
scale_color_manual(values = relationship_colors) +
facet_wrap(~participant_first_choice,
labeller = labeller(
participant_first_choice = function(x) {
paste("First choice:", x)
}
)
) +
theme(legend.position = "bottom")
